home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / COMMUNIC / 0576.ZIP / STAYSUBS.420 < prev    next >
Text File  |  1986-08-06  |  17KB  |  401 lines
  1. {****************************************************************************}
  2. {                         S T A Y S U B S  .  I N C                          }
  3. {****************************************************************************}
  4.       {---------------------------------------------------------}
  5.       {            S E T U P   I N T E R R U P T                }
  6.       {---------------------------------------------------------}{
  7. {        Msg # *48   Dated 07-07-86 16:54:36
  8.          From: NEIL RUBENKING
  9.          To: LANE FERRIS
  10.          Re: STAY, WON'T YOU?
  11.  
  12.          Lane,
  13.               Here's what I did:
  14. }
  15.   PROCEDURE Setup_Interrupt(IntNo :byte; VAR IntVec :vector; offset :integer);
  16.   BEGIN
  17.     Regs.Ax := $3500 + IntNo;
  18.     Intr(DosI21,Regs);            {get the address of interrupt }
  19.     IntVec.IP := Regs.BX;            { Location of Interrupt Ip }
  20.     IntVec.CS := Regs.Es;            { Location of Interrupt Cs }
  21.  
  22.     Regs.Ax := $2500 + IntNo;     { set the interrupt to point to}
  23.     Regs.Ds := Cseg;              {  our procedure}
  24.     Regs.Dx := Offset;
  25.     Intr (DosI21,Regs);
  26.   END;
  27. (******************* C O M M E N T *****************************************
  28. {in the main part of the program}
  29.       Setup_Interrupt(BIOSI16, BIOS_Int16, Ofs(Stay_INT16)); {keyboard}
  30.       Setup_Interrupt(BIOSI10, BIOS_Int10, Ofs(Stay_INT10)); {video}
  31.       Setup_Interrupt(BIOSI8, BIOS_Int8, Ofs(Stay_INT8));    {timer}
  32.       Setup_Interrupt(BIOSI13, BIOS_Int13, Ofs(Stay_INT13)); {disk}
  33.       Setup_Interrupt(DOSI21, DOS_Int21, Ofs(Stay_INT21));   {DOSfunction}
  34.       Setup_Interrupt(DOSI28, DOS_Int28, Ofs(Stay_INT28));   {DOS idle}
  35. ********************* C O M M E N T *****************************************)
  36.       {---------------------------------------------------------}
  37.       {                 S E  T    D  T  A                       }
  38.       {---------------------------------------------------------}
  39.    Procedure SetDTA(var segment, offset : integer );
  40.    BEGIN
  41.      regs.ax := $1A00;      { Function used to get current DTA address }
  42.      regs.Ds := segment;    { Segment of DTA returned by DOS }
  43.      regs.Dx := offset;     { Offset of DTA returned }
  44.      MSDos( regs );         { Execute MSDos function request }
  45.    END;
  46.       {---------------------------------------------------------}
  47.       {                 G E  T    D  T  A                       }
  48.       {---------------------------------------------------------}
  49.    Procedure GetDTA(var segment, offset : integer );
  50.    BEGIN
  51.      regs.ax := $2F00;      { Function used to get current DTA address }
  52.      MSDos( regs );         { Execute MSDos function request }
  53.      segment := regs.ES;    { Segment of DTA returned by DOS }
  54.      offset  := regs.Bx;    { Offset of DTA returned }
  55.    END;
  56.       {---------------------------------------------------------}
  57.       {                 S E  T    P  S  P                       }
  58.       {---------------------------------------------------------}
  59.    Procedure SetPSP(var segment : integer );
  60.    BEGIN
  61.  
  62.        { A bug in DOS 2.0, 2.1, causes DOS to clobber its standard stack   }
  63.        { when the PSP get/set functions are issued at the DOS prompt. The  }
  64.        { following checks are made, forcing DOS to use the "critical"      }
  65.        { stack when the TSR enters at the INDOS level.                     }
  66.  
  67.                                       {If Version less then 3.0 and INDOS set }
  68.    If DosVersion < 3 then             { then set the Dos Critical Flag        }
  69.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  70.           Mem[DosStat2.CS:DosStat2.IP] := $FF;
  71.  
  72.      regs.ax := $5000;      { Function to set current PSP address }
  73.      regs.bx := segment;    { Segment of PSP to be used by DOS }
  74.      MSDos( regs );         { Execute MSDos function request }
  75.  
  76.                                       {If Version less then 3.0 and INDOS set }
  77.      If DosVersion < 3 then           { then clear the Dos Critical Flag     }
  78.         If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  79.            Mem[DosStat2.CS:DosStat2.IP] := $00;
  80.  
  81.    END;
  82.       {---------------------------------------------------------}
  83.       {                 G E  T    P  S  P                       }
  84.       {---------------------------------------------------------}
  85.    Procedure GetPSP(var segment : integer );
  86.    BEGIN
  87.  
  88.        { A bug in DOS 2.0, 2.1, causes DOS to clobber its standard stack   }
  89.        { when the PSP get/set functions are issued at the DOS prompt. The  }
  90.        { following checks are made, forcing DOS to use the "critical"      }
  91.        { stack when the TSR enters at the INDOS level.                     }
  92.  
  93.                                {If Version less then 3.0 and INDOS set }
  94.    If DosVersion < 3 then      { then set the Dos Critical Flag        }
  95.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  96.           Mem[DosStat2.CS:DosStat2.IP] := $FF;
  97.  
  98.      regs.ax := $5100;      { Function to get current PSP address }
  99.      MSDos( regs );         { Execute MSDos function request }
  100.      segment := regs.Bx;    { Segment of PSP returned by DOS }
  101.  
  102.                                 {IF DOS Version less then 3.0 and INDOS set }
  103.    If DosVersion < 3 then       { then clear the Dos Critical Flag     }
  104.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  105.            Mem[DosStat2.CS:DosStat2.IP] := $00;
  106.  
  107.    END;
  108.     {---------------------------------------------------------------}
  109.     {        G e t   C o n t r o l  C (break)  V e c t o r          }
  110.     {---------------------------------------------------------------}
  111. Type
  112.     Arrayparam = array [1..2] of integer;
  113. Const
  114.      SavedCtlC: arrayparam = (0,0);
  115.      NewCtlC  : arrayparam = (0,0);
  116.  Procedure GetCtlC(Var SavedCtlC:arrayparam);
  117.     Begin                     {Record the Current Ctrl-C Vector}
  118.        With Regs Do
  119.        Begin
  120.        AX:=$3523;
  121.        MsDos(Regs);
  122.        SavedCtlC[1]:=BX;
  123.        SavedCtlC[2]:=ES;
  124.        End;
  125.     End;
  126.     {---------------------------------------------------------------}
  127.     {        S e t   C o n t r o l  C   V e c t o r                 }
  128.     {---------------------------------------------------------------}
  129.     Procedure IRET;          {Dummy Ctrl-C routine}
  130.        Begin
  131.        inline($5D/$5D/$CF);  {Pop Bp/Pop Bp/Iret}
  132.        end;
  133.  Procedure SetCtlC(Var CtlCptr:arrayparam);
  134.     Begin                     {Set the New Ctrl-C Vector}
  135.        With Regs Do
  136.        Begin
  137.         AX:=$2523;
  138.         DS:=CtlCptr[2];
  139.         DX:=CtlCptr[1];
  140.         MsDos(Regs);
  141.        End;
  142.     End;
  143. {----------------------------------------------------------------------}
  144. {           K e y i n   :   R e a d  K e a b o a r d                   }
  145. {----------------------------------------------------------------------}
  146. Function Keyin: char;          { Get a key from the Keyboard           }
  147.    Var Ch : char;              { If extended key, fold above 127       }
  148.    Begin                       {---------------------------------------}
  149.       Repeat until Keypressed;
  150.       Read(Kbd,Ch);
  151.       if (Ch = Esc) and KeyPressed then
  152.          Begin
  153.          Read(Kbd,Ch);
  154.          Ch := Char(Ord(Ch) + 127);
  155.          End;
  156.       Keyin := Ch;
  157.    End;  {Keyin}
  158. {----------------------------------------------------------------------}
  159. {          B e e p   :  S o u n d  t h e  H o r n                      }
  160. {----------------------------------------------------------------------}
  161. Procedure Beep(N :integer); {------------------------------------------}
  162.    Begin                    {  This routine sounds a tone of frequency }
  163.       Sound(n);             {  N for approximately 100 ms              }
  164.       Delay(100);           {------------------------------------------}
  165.       Sound(n div 2);
  166.       Delay(100);
  167.       Nosound;
  168.       End {Beep} ;
  169.  
  170.       {--------------------------------------------------------------}
  171.       {                I N T E R R U P T    2 4                      }
  172.       {--------------------------------------------------------------}
  173. { Version 2.0, 1/28/86
  174.   -  Bela Lubkin
  175.      CompuServe 76703,3015
  176.  
  177.      Apologetically mangled by Lane Ferris
  178.  
  179.   For MS-DOS version 2.0 or greater, Turbo Pascal 1.0 or greater.
  180.  
  181.   Thanks to Marshall Brain for the original idea for these routines.
  182.   Thanks to John Cooper for pointing out a small flaw in the code.
  183.  
  184.   These routines provide a method for Turbo Pascal programs to trap
  185.   MS-DOS interrupt 24 (hex).  INT 24h is called by DOS when a 'critical
  186.   error' occurs, and it normally prints the familiar "Abort, Retry,
  187.   Ignore?" message.
  188.  
  189.   With the INT 24h handler installed, errors of this type will be passed
  190.   on to Turbo Pascal as an error.  If I/O checking is on, this will cause
  191.   a program crash.  If I/O checking is off, IOResult will return an error
  192.   code.  The global variable INT24Err will be true if an INT 24h error
  193.   has occurred.  The variable INT24ErrorCode will contain the INT 24h
  194.   error code as given by DOS. These errors can be found in the DOS
  195.   Technical Reference Manual.
  196.  
  197.   It is intended that INT24Result be used in place of IOResult. Calling
  198.   INT24Result clears IOResult.  The simple way to use INT24Result is just
  199.   to check that it returns zero, and if not, handle all errors the same.
  200.   The more complicated way is to interpret the code.  The integer
  201.   returned by INT24Result can be looked at as two bytes.  By assigning
  202.   INT24Result to a variable, you can then examine the two bytes:
  203.   (Hi(<variable>)-1) will give the DOS critical error code, or
  204.   (<variable> And $FF00) will return an integer from the table listed in
  205.   the INT24Result procedure (two ways of looking at the critical error);
  206.   Lo(<variable>) will give Turbo's IOResult.  A critical error will
  207.   always be reflected in INT24Result, but the IOResult part of
  208.   INT24Result will not necessarily be nonzero; in particular,
  209.   unsuccessful writes to character devices will not register as a Turbo
  210.   I/O error.
  211.  
  212.   INT24Result should be called after any operation which might cause a
  213.   critical error, if Turbo's I/O checking is disabled.  If it is enabled,
  214.   the program will be aborted except in the above noted case of writes to
  215.   character devices.
  216.  
  217.   Also note that different versions of DOS and the BIOS seem to react to
  218.   printer errors at vastly different rates.  Be prepared to wait a while
  219.   for anything to happen (in an error situation) on some machines.
  220.  
  221.   These routines are known to work correctly with: Turbo Pascal 1.00B PC-DOS;
  222.                                                    Turbo Pascal 2.00B PC-DOS;
  223.                                                    Turbo Pascal 2.00B MS-DOS;
  224.                                                    Turbo Pascal 3.01A PC-DOS.
  225.   Other MS-DOS and PC-DOS versions should work.
  226.  
  227.   Note that Turbo 2.0's normal IOResult codes for MS-DOS DO NOT
  228.   correspond to the I/O error numbers given in Appendix I of the Turbo
  229.   2.0 manual, or to the error codes given in the I/O error nn,
  230.   PC=aaaa/Program aborted message.  Turbo 3.0 IOResult codes do match the
  231.   manual.  Here is a table of the correspondence (all numbers in
  232.   hexadecimal):
  233.  
  234.   Turbo 2.0 IOResult    Turbo error, Turbo 3.0 IOResult
  235.   ------------------    -------------------------------------------------
  236.      00                 00  none
  237.      01                 90  record length mismatch
  238.      02                 01  file does not exist
  239.      03                 F1  directory is full
  240.      04                 FF  file disappeared
  241.      05                 02  file not open for input
  242.      06                 03  file not open for output
  243.      07                 99  unexpected end of file
  244.      08                 F0  disk write error
  245.      09                 10  error in numeric format
  246.      0A                 99  unexpected end of file
  247.      0B                 F2  file size overflow
  248.      0C                 99  unexpected end of file
  249.      0D                 F0  disk write error
  250.      0E                 91  seek beyond end of file
  251.      0F                 04  file not open
  252.      10                 20  operation not allowed on a logical device
  253.      11                 21  not allowed in direct mode
  254.      12                 22  assign to standard files is not allowed
  255.      --                 F3  Too many open files
  256.  
  257.   -  Bela Lubkin
  258.      CompuServe 76703,3015
  259.      1/28/86
  260. }
  261.  
  262. Const
  263.   INT24Err: Boolean=False;
  264.   INT24ErrCode: Byte=0;
  265.   OldINT24: Array [1..2] Of Integer=(0,0);
  266.  
  267. Var
  268.   RegisterSet: Record Case Integer Of
  269.                  1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  270.                  2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  271.                End;
  272.  
  273. Procedure INT24;     { Interrupt 24 Service Routine }
  274.   Begin
  275.  
  276.     Inline( $2E/$C6/$06/ Int24Err / $01/$50/$89/$F8/$2E/$A2/ Int24ErrCode
  277.             /$58/$B0/$00/$89/$EC/$5D/$CF);
  278.  
  279. {   Turbo:  PUSH BP                    Save caller's stack frame
  280.             MOV  BP,SP                  Set up this procedure's stack frame
  281.             PUSH BP                     ?
  282.     Inline:
  283.             MOV  BYTE CS:[INT24Err],1   Set INT24Err to True
  284.             PUSH AX
  285.             MOV  AX,DI                  Get INT 25h error code
  286.             MOV  CS:[INT24ErrCode],AL   Save it in INT24ErrCode
  287.             POP  AX
  288.             MOV  AL,0                   Tell DOS to ignore the error
  289.             MOV  SP,BP                  Unwind stack frame
  290.             POP  BP
  291.             IRET                        Let DOS handle it from here
  292. }
  293.   End;
  294.  
  295.        {------------------------------------------------------------}
  296.        {       I N T  2 4   O N                                     }
  297.        {------------------------------------------------------------}
  298.             { Grab the Critical error ptr from the previous user}
  299. Procedure INT24On;  { Enable INT 24h trapping }
  300.   Begin
  301.     INT24Err:=False;
  302.     With RegisterSet Do
  303.      Begin
  304.       AX:=$3524;
  305.       MsDos(RegisterSet);
  306.  
  307.       If (OldINT24[1] Or OldINT24[2])=0 Then
  308.        Begin
  309.         OldINT24[1]:=ES;
  310.         OldINT24[2]:=BX;
  311.        End;
  312.       DS:=CSeg;
  313.       DX:=Ofs(INT24);
  314.       AX:=$2524;
  315.       MsDos(RegisterSet);
  316.      End;
  317.   End;
  318.        {------------------------------------------------------------}
  319.        {                 I N T  2 4   O F F                         }
  320.        {------------------------------------------------------------}
  321.          { Give Critical Error Service pointer back to previous user }
  322. Procedure INT24Off;
  323.   Begin
  324.     INT24Err:=False;
  325.     If OldINT24[1]<>0 Then
  326.       With RegisterSet Do
  327.        Begin
  328.         DS:=OldINT24[1];
  329.         DX:=OldINT24[2];
  330.         AX:=$2524;
  331.         MsDos(RegisterSet);
  332.        End;
  333.     OldINT24[1]:=0;
  334.     OldINT24[2]:=0;
  335.   End;
  336.  
  337. Function INT24Result: Integer;
  338.   Var
  339.     I:Integer;
  340.  
  341.   Begin
  342.     I:=IOResult;
  343.     If INT24Err Then
  344.      Begin
  345.       I:=I+256*Succ(INT24ErrCode);
  346.       INT24On;
  347.      End;
  348.     INT24Result:=I;
  349.   End;
  350.  
  351. { INT24Result returns all the regular Turbo IOResult codes if no critical
  352.   error has occurred.  If a critical error, then the following values are
  353.   added to the error code from Turbo:
  354.    256:  Attempt to write on write protected disk
  355.    512:  Unknown unit                 [internal dos error]
  356.    768:  Drive not ready              [drive door open or bad drive]
  357.    1024: Unknown command              [internal dos error]
  358.    1280: Data error (CRC)             [bad sector or drive]
  359.    1536: Bad request structure length [internal dos error]
  360.    1792: Seek error                   [bad disk or drive]
  361.    2048: Unknown media type           [bad disk or drive]
  362.    2304: Sector not found             [bad disk or drive]
  363.    2560: Printer out of paper         [anything that the printer might signal]
  364.    2816: Write fault                  [character device not ready]
  365.    3072: Read fault                   [character device not ready]
  366.    3328: General failure              [several meanings]
  367.  
  368.   If you need the IOResult part, use
  369.    I:=INT24Result and 255; [masks out the INT 24h code]
  370.  
  371.   For the INT 24h code, use
  372.    I:=INT24Result Shr 8;   [same as Div 256, except faster]
  373.  
  374.   INT24Result clears both error codes, so you must assign it to a variable if
  375.   you want to extract both codes:
  376.    J:=INT24Result;
  377.    WriteLn('Turbo IOResult  = ',J And 255);
  378.    WriteLn('DOS INT 24h code = ',J Shr 8);
  379.  
  380.   Note that in most cases, errors on character devices (LST and AUX) will not
  381.   return an IOResult, only an INT 24h error code. }
  382.  
  383. { Main program.  Delete next line to enable }
  384.  
  385.        {---------------------------------------------------------}
  386.        {            G E T    E R R O R    C O D E                }
  387.        {---------------------------------------------------------}
  388.    Procedure GetErrorCode;
  389.     Begin
  390.     Error := IOresult;                  {Read the I/O result}
  391.  
  392.     If INT24Err Then
  393.      Begin
  394.       Error:=Error+256*Succ(INT24ErrCode);
  395.       INT24On;
  396.      End;
  397.     Good := (Error = 0);                {Set Boolean Result }
  398.   End;
  399.  
  400.   {--------------------------------------------------------------}
  401.